perm filename TEST.PAS[S1,ALS] blob sn#491656 filedate 1979-12-30 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	program TEST
C00006 ENDMK
CāŠ—;
program TEST;

const	ZERO = 0;  ONE = 1;  MAX = 1000000000; (* 10**9 *)

var	A,A2, B, B2, C, C2, COUNT : integer;
	N, X, Y, Z, LAST : integer;
	PTAB : array [1..9000] of integer;
	FTAB : array [1..50] of integer;

procedure PRIME;
    begin
    N := 11;  X := 2;  LAST := 4;
    PTAB[1] := 2;  PTAB[2] := 3;  PTAB[3] := 5;  PTAB[4] := 7;
    while LAST < 9000 do
	begin
	while ((N div PTAB[X]) >= PTAB[X]) do
	    begin
	    if N mod PTAB[X] = 0 then
		begin
		N := N + 2;  X := 2;
		end
	    else
		begin
 		X := X + 1;
		end;
	    end;
	LAST := LAST + 1;
	PTAB[LAST] := N;
if LAST > 8995 then BEGIN writeln(tty,LAST:6,N:20); BREAK; end;
	X := 2;  N := N + 2;
	end;
    end;

function TESTN (var N2, N1 : INTEGER) : boolean;
var  Y : integer;
    begin
    X := 1;
    Y := PTAB[X];
    TESTN := true;
    if N2 > 0 then
 	begin
	while (N2 >= Y) or (((N2 mod Y) * MAX + N1) div Y >= Y) do
 	    begin
	    if (((N2 mod Y) * MAX + N1) mod Y) <> 0 then
		begin
		X := X + 1;
 		if X <= 9000 then   Y := PTAB[X]
		else writeln(tty,' PTAB overflow ');
		end
	    else
		begin
		TESTN := false;
		Y := MAX;
 		end;
	    end;
	end
    else
	begin
	while N1 div Y >= Y do
	    begin
	    if N1 mod Y <> 0 then 
		begin
		X := X + 1;
		Y := PTAB[X];
		end
	    else
		begin
		TESTN := false;
		Y := N1;
		end;
	    end;
	end;
    end;

begin
PRIME;
A := 1; A2 := 0;
B := 1; B2 := 0;
COUNT := 2;
while COUNT < 50 do
    begin
    C := A + B;  C2 := A2 + B2;
    if C >= MAX then
	begin
	C2 := C2 + 1;   C := C - MAX;
	end;
    A := B;  A2 := B2;
    B := C;  B2 := C2;
    COUNT := COUNT + 1;
    Y := 0;
    if TESTN(B2,B) then
	begin
	write(OUTPUT, COUNT:11);
	write(tty, COUNT:11);
	if B2 = 0 then
	    begin
 	    writeln(TTY,'            ',B:9); BREAK;
	    write(OUTPUT,'            ',B:9);
	    end
	else
	    begin
	    write(OUTPUT,B2:12,B:9);
	    writeln(TTY,B2:12,B:9); BREAK;
	    end;
	Y := 0;
	if TESTN(Y,COUNT) then writeln(OUTPUT)
	else writeln('  exception');
	end;
    end;
end.